unit Unit5;

interface

{$include rtcDefs.inc}

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls,

  rtcThrPool, // get access to RTC Thread Pool parameters
  rtcDataSrv, rtcSystem, rtcInfo, rtcConn, rtcHttpSrv, ExtCtrls;

type
  TForm5 = class(TForm)
    RtcHttpServer1: TRtcHttpServer;
    RtcDataProvider1: TRtcDataProvider;
    bListen: TButton;
    Memo1: TMemo;
    ConfigPanel: TPanel;
    xMultiThreaded: TCheckBox;
    Label1: TLabel;
    ePoolSize: TEdit;
    Label2: TLabel;
    ePort: TEdit;
    xJSON: TCheckBox;
    xBlocking: TCheckBox;
    eFileName: TEdit;
    xFileName: TLabel;
    Label3: TLabel;
    eResponseText: TEdit;
    xHeaders: TCheckBox;
    procedure RtcDataProvider1CheckRequest(Sender: TRtcConnection);
    procedure RtcDataProvider1DataReceived(Sender: TRtcConnection);
    procedure RtcHttpServer1ListenStart(Sender: TRtcConnection);
    procedure RtcHttpServer1ListenStop(Sender: TRtcConnection);
    procedure RtcHttpServer1ListenError(Sender: TRtcConnection; E: Exception);
    procedure bListenClick(Sender: TObject);
    procedure RtcHttpServer1ListenLost(Sender: TRtcConnection);
    procedure RtcHttpServer1Exception(Sender: TRtcConnection; E: Exception);
    procedure RtcHttpServer1InvalidRequest(Sender: TRtcConnection);
    procedure RtcHttpServer1RequestNotAccepted(Sender: TRtcConnection);
  private
    { Private declarations }
  public
    { Public declarations }
    trueJSON,
    plusHeaders:boolean;
    S_ServiceFunctionName,
    S_ResponseText,
    S_ResponseJSON:String;
  end;

var
  Form5: TForm5;

implementation

{$R *.dfm}

procedure TForm5.bListenClick(Sender: TObject);
begin
if RtcHttpServer1.isListening then
  RtcHttpServer1.StopListen
else
  begin
  { Changing the Thread Pool size is NOT necessary, nor required.
    This option is provided here ONLY for testing Server behavior.

    RTC Servers can handle any number of connections with only 1 thread,
    more threads simply allow more parallel user events to run
    (for example, long running daabase queries). 

    Default Thread Pool size is 64 (Windows), allowing 64 functions 
    or user events to be running at the same time (parallel). }

  RTC_THREAD_POOL_MAX := StrToInt(Trim(ePoolSize.Text));

  trueJSON := xJSON.Checked;
  plusHeaders := xHeaders.Checked;

  // URI to respond to (Request.FileName)
  S_ServiceFunctionName := URL_Encode(eFileName.Text);

  if trueJSON then
    // Plain Text for use with RTC JSON Generator (Option 1)
    S_ResponseText := eResponseText.Text
  else
    // Manually created JSON String (Option 2)
    S_ResponseJSON := '{"result":"'+UTF8Encode(eResponseText.Text)+'"}';

  RtcHttpServer1.Blocking:=xBlocking.Checked;
  RtcHttpServer1.MultiThreaded:=xMultiThreaded.Checked;
  RtcHttpServer1.ServerPort:=Trim(ePort.Text);
  RtcHttpServer1.Listen;
  end;
end;

procedure TForm5.RtcDataProvider1CheckRequest(Sender: TRtcConnection);
var
  Srv:TRtcDataServer absolute Sender;
begin
{ Check Request parameters and acccept the requests you want to handle. }
  if Srv.Request.FileName = S_ServiceFunctionName then
    Srv.Accept;
end;

procedure TForm5.RtcDataProvider1DataReceived(Sender: TRtcConnection);
var
  Srv:TRtcDataServer absolute Sender;
  Result:TRtcRecord;
  // MyContent:String;
begin
  if Srv.Request.Complete then
    begin
    { If content body is expected, use "Srv.Read" or "Srv.ReadEx" to read it. }
    // MyContent := Srv.Read;

    { Then, return the appropriate response based on the request headers and/or content body. }
    if plusHeaders then
      begin
      // Some Headers might be required by the 3rd-party Client
      // Set them before you start to write the response content out
      Srv.Response['Content-Type']:='application/json; charset=UTF-8';
      Srv.Response['Server']:='Simple RTC Test Server';
      Srv.Response['X-Powered-By']:='RTC SDK '+RtcHttpServer1.Version_SDK;
      Srv.Response['Date']:=DateTime2Str(Now);
      end;

    if trueJSON then
      begin
      { You can use any RTC Value Object (TRtcValue, TRtcRecord, TRtcArray, TRtcDataSet, ...)
        to prepare a JSON object and use the "toJSON" or "toJSONEx" method on the base object 
        to generate a JSON string containing the structure ... }
      Result:=TRtcRecord.Create;
      try
        Result.asText['result']:=S_ResponseText;
        Srv.WriteEx(Result.toJSONEx);
      finally
        Result.Free;
        end;
      end
    else
      begin
      { Or, use a preformatted JSON String (generated by hand or by a 3rd-party tool)
        and send it out as a preformatted JSON String. 
        The String used with "Srv.Write" may ONLY contain 8-bit characters.
        If it is a Unicode string, encode it using UTF8Encode first (see above). }
      Srv.Write(S_ResponseJSON);
      end;
    end;
end;

procedure TForm5.RtcHttpServer1RequestNotAccepted(Sender: TRtcConnection);
var
  Srv:TRtcDataServer absolute Sender;
begin
  Srv.Write('Bad Request: '+Srv.Request.FileName);
end;

procedure TForm5.RtcHttpServer1Exception(Sender: TRtcConnection; E: Exception);
begin
if not Sender.inMainThread then
  Sender.Sync(RtcHttpServer1Exception, E)
else
  Memo1.Lines.Add('Unhandled Exception '+E.ClassName+':'+#13#10+E.Message);
end;

procedure TForm5.RtcHttpServer1InvalidRequest(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
  Sender.Sync(RtcHttpServer1InvalidRequest)
else
  Memo1.Lines.Add('Received an invalid Request.');
end;

procedure TForm5.RtcHttpServer1ListenError(Sender: TRtcConnection; E: Exception);
begin
if not Sender.inMainThread then
  Sender.Sync(RtcHttpServer1ListenError, E)
else
  Memo1.Lines.Text:='Can not Start the Server on Port '+Sender.ServerPort+#13#10+E.Message;
end;

procedure TForm5.RtcHttpServer1ListenLost(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
  Sender.Sync(RtcHttpServer1ListenLost)
else
  begin
  ConfigPanel.Enabled:=True;
  Memo1.Lines.Text:='Server stopped unexpectedly.';
  bListen.Caption:='START';
  end;
end;

procedure TForm5.RtcHttpServer1ListenStart(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
  Sender.Sync(RtcHttpServer1ListenStart)
else
  begin
  ConfigPanel.Enabled:=False;
  Memo1.Lines.Text:='Server is running on Port '+Sender.LocalPort+#13#10+
  'Press STOP if you need to change the parameters.';
  bListen.Caption:='STOP';
  end;
end;

procedure TForm5.RtcHttpServer1ListenStop(Sender: TRtcConnection);
begin
if not Sender.inMainThread then
  Sender.Sync(RtcHttpServer1ListenStop)
else
  begin
  ConfigPanel.Enabled:=True;
  Memo1.Lines.Text:='Server stopped by user.'+#13#10+
                    'Configure all parameters and press START.';
  bListen.Caption:='START';
  end;
end;

end.
